home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / blt2.4 / graph.tcl < prev    next >
Encoding:
Text File  |  2009-12-04  |  13.8 KB  |  497 lines

  1.  
  2. proc Blt_ActiveLegend { graph } {
  3.     $graph legend bind all <Enter> [list blt::ActivateLegend $graph ]
  4.     $graph legend bind all <Leave> [list blt::DeactivateLegend $graph]
  5.     $graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]
  6. }
  7.  
  8. proc Blt_Crosshairs { graph } {
  9.     blt::Crosshairs $graph 
  10. }
  11.  
  12. proc Blt_ResetCrosshairs { graph state } {
  13.     blt::Crosshairs $graph "Any-Motion" $state
  14. }
  15.  
  16. proc Blt_ZoomStack { graph } {
  17.     blt::ZoomStack $graph
  18. }
  19.  
  20. proc Blt_PrintKey { graph } {
  21.     blt::PrintKey $graph
  22. }
  23.  
  24. proc Blt_ClosestPoint { graph } {
  25.     blt::ClosestPoint $graph
  26. }
  27.  
  28. #
  29. # The following procedures that reside in the "blt" namespace are
  30. # supposed to be private.
  31. #
  32.  
  33. proc blt::ActivateLegend { graph } {
  34.     set elem [$graph legend get current]
  35.     $graph legend activate $elem
  36. }
  37. proc blt::DeactivateLegend { graph } {
  38.     set elem [$graph legend get current]
  39.     $graph legend deactivate $elem
  40. }
  41.  
  42. proc blt::HighlightLegend { graph } {
  43.     set elem [$graph legend get current]
  44.     set relief [$graph element cget $elem -labelrelief]
  45.     if { $relief == "flat" } {
  46.     $graph element configure $elem -labelrelief raised
  47.     $graph element activate $elem
  48.     } else {
  49.     $graph element configure $elem -labelrelief flat
  50.     $graph element deactivate $elem
  51.     }
  52. }
  53.  
  54. proc blt::Crosshairs { graph {event "Any-Motion"} {state "on"}} {
  55.     $graph crosshairs $state
  56.     bind crosshairs-$graph <$event>   {
  57.     %W crosshairs configure -position @%x,%y 
  58.     }
  59.     bind crosshairs-$graph <Leave>   {
  60.     %W crosshairs off
  61.     }
  62.     bind crosshairs-$graph <Enter>   {
  63.     %W crosshairs on
  64.     }
  65.     $graph crosshairs configure -color red
  66.     if { $state == "on" } {
  67.     blt::AddBindTag $graph crosshairs-$graph
  68.     } elseif { $state == "off" } {
  69.     blt::RemoveBindTag $graph crosshairs-$graph
  70.     }
  71. }
  72.  
  73. proc blt::InitStack { graph } {
  74.     global zoomInfo
  75.     set zoomInfo($graph,interval) 100
  76.     set zoomInfo($graph,afterId) 0
  77.     set zoomInfo($graph,A,x) {}
  78.     set zoomInfo($graph,A,y) {}
  79.     set zoomInfo($graph,B,x) {}
  80.     set zoomInfo($graph,B,y) {}
  81.     set zoomInfo($graph,stack) {}
  82.     set zoomInfo($graph,corner) A
  83. }
  84.  
  85. proc blt::ZoomStack { graph {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
  86.     global zoomInfo zoomMod
  87.     
  88.     blt::InitStack $graph
  89.     
  90.     if { [info exists zoomMod] } {
  91.     set modifier $zoomMod
  92.     } else {
  93.     set modifier ""
  94.     }
  95.     bind zoom-$graph <${modifier}${start}> { blt::SetZoomPoint %W %x %y }
  96.     bind zoom-$graph <${modifier}${reset}> { 
  97.     if { [%W inside %x %y] } { 
  98.         blt::ResetZoom %W 
  99.     }
  100.     }
  101.     blt::AddBindTag $graph zoom-$graph
  102. }
  103.  
  104. proc blt::PrintKey { graph {event "Shift-ButtonRelease-3"} } {
  105.     bind print-$graph <$event>  { Blt_PostScriptDialog %W }
  106.     blt::AddBindTag $graph print-$graph
  107. }
  108.  
  109. proc blt::ClosestPoint { graph {event "Control-ButtonPress-2"} } {
  110.     bind closest-point-$graph <$event>  {
  111.     blt::FindElement %W %x %y
  112.     }
  113.     blt::AddBindTag $graph closest-point-$graph
  114. }
  115.  
  116. proc blt::AddBindTag { widget tag } {
  117.     set oldTagList [bindtags $widget]
  118.     if { [lsearch $oldTagList $tag] < 0 } {
  119.     bindtags $widget [linsert $oldTagList 0  $tag]
  120.     }
  121. }
  122.  
  123. proc blt::RemoveBindTag { widget tag } {
  124.     set oldTagList [bindtags $widget]
  125.     set index [lsearch $oldTagList $tag]
  126.     if { $index >= 0 } {
  127.     bindtags $widget [lreplace $oldTagList $index $index]
  128.     }
  129. }
  130.  
  131. proc blt::FindElement { graph x y } {
  132.     if ![$graph element closest $x $y info -interpolate yes] {
  133.     beep
  134.     return
  135.     }
  136.     # --------------------------------------------------------------
  137.     # find(name)        - element Id
  138.     # find(index)        - index of closest point
  139.     # find(x) find(y)        - coordinates of closest point
  140.     #                  or closest point on line segment.
  141.     # find(dist)        - distance from sample coordinate
  142.     # --------------------------------------------------------------
  143.     set markerName "bltClosest_$info(name)"
  144.     catch { $graph marker delete $markerName }
  145.     $graph marker create text -coords { $info(x) $info(y) } \
  146.     -name $markerName \
  147.     -text "$info(name): $info(dist)\nindex $info(index)" \
  148.     -font *lucida*-r-*-10-* \
  149.     -anchor center -justify left \
  150.     -yoffset 0 -bg {} 
  151.  
  152.     set coords [$graph invtransform $x $y]
  153.     set nx [lindex $coords 0]
  154.     set ny [lindex $coords 1]
  155.  
  156.     $graph marker create line -coords "$nx $ny $info(x) $info(y)" \
  157.     -name line.$markerName 
  158.  
  159.     blt::FlashPoint $graph $info(name) $info(index) 10
  160.     blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10
  161. }
  162.  
  163. proc blt::FlashPoint { graph name index count } {
  164.     if { $count & 1 } {
  165.         $graph element deactivate $name 
  166.     } else {
  167.         $graph element activate $name $index
  168.     }
  169.     incr count -1
  170.     if { $count > 0 } {
  171.     after 200 blt::FlashPoint $graph $name $index $count
  172.     update
  173.     } else {
  174.     eval $graph marker delete [$graph marker names "bltClosest_*"]
  175.     }
  176. }
  177.  
  178. proc blt::GetCoords { graph x y index } {
  179.     global zoomInfo
  180.     if { [$graph cget -invertxy] } {
  181.     set zoomInfo($graph,$index,x) $y
  182.     set zoomInfo($graph,$index,y) $x
  183.     } else {
  184.     set zoomInfo($graph,$index,x) $x
  185.     set zoomInfo($graph,$index,y) $y
  186.     }
  187. }
  188.  
  189. proc blt::MarkPoint { graph index } {
  190.     global zoomInfo
  191.     set x [$graph xaxis invtransform $zoomInfo($graph,$index,x)]
  192.     set y [$graph yaxis invtransform $zoomInfo($graph,$index,y)]
  193.     set marker "zoomText_$index"
  194.     set text [format "x=%.4g\ny=%.4g" $x $y] 
  195.  
  196.     if [$graph marker exists $marker] {
  197.          $graph marker configure $marker -coords { $x $y } -text $text 
  198.     } else {
  199.         $graph marker create text -coords { $x $y } -name $marker \
  200.            -font *lucida*-r-*-10-* \
  201.         -text $text -anchor center -bg {} -justify left
  202.     }
  203. }
  204.  
  205. proc blt::DestroyZoomTitle { graph } {
  206.     global zoomInfo
  207.  
  208.     if { $zoomInfo($graph,corner) == "A" } {
  209.     catch { $graph marker delete "zoomTitle" }
  210.     }
  211. }
  212.  
  213. proc blt::PopZoom { graph } {
  214.     global zoomInfo
  215.  
  216.     set zoomStack $zoomInfo($graph,stack)
  217.     if { [llength $zoomStack] > 0 } {
  218.     set cmd [lindex $zoomStack 0]
  219.     set zoomInfo($graph,stack) [lrange $zoomStack 1 end]
  220.     eval $cmd
  221.     blt::ZoomTitleLast $graph
  222.     busy hold $graph
  223.     update
  224.     busy release $graph
  225.     after 2000 "blt::DestroyZoomTitle $graph"
  226.     } else {
  227.     catch { $graph marker delete "zoomTitle" }
  228.     }
  229. }
  230.  
  231. # Push the old axis limits on the stack and set the new ones
  232.  
  233. proc blt::PushZoom { graph } {
  234.     global zoomInfo
  235.     eval $graph marker delete [$graph marker names "zoom*"]
  236.     if { [info exists zoomInfo($graph,afterId)] } {
  237.     after cancel $zoomInfo($graph,afterId)
  238.     }
  239.     set x1 $zoomInfo($graph,A,x)
  240.     set y1 $zoomInfo($graph,A,y)
  241.     set x2 $zoomInfo($graph,B,x)
  242.     set y2 $zoomInfo($graph,B,y)
  243.  
  244.     if { ($x1 == $x2) || ($y1 == $y2) } { 
  245.     # No delta, revert to start
  246.     return
  247.     }
  248.     set cmd {}
  249.     foreach margin { xaxis yaxis x2axis y2axis } {
  250.     foreach axis [$graph $margin use] {
  251.         set min [$graph axis cget $axis -min] 
  252.         set max [$graph axis cget $axis -max]
  253.         set c [list $graph axis configure $axis -min $min -max $max]
  254.         append cmd "$c\n"
  255.     }
  256.     }
  257.     set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
  258.  
  259.  
  260.     foreach margin { xaxis x2axis } {
  261.     foreach axis [$graph $margin use] {
  262.         set min [$graph axis invtransform $axis $x1]
  263.         set max [$graph axis invtransform $axis $x2]
  264.         if { $min > $max } { 
  265.         $graph axis configure $axis -min $max -max $min
  266.         } else {
  267.         $graph axis configure $axis -min $min -max $max
  268.         }
  269.     }
  270.     }
  271.     foreach margin { yaxis y2axis } {
  272.     foreach axis [$graph $margin use] {
  273.         set min [$graph axis invtransform $axis $y1]
  274.         set max [$graph axis invtransform $axis $y2]
  275.         if { $min > $max } { 
  276.         $graph axis configure $axis -min $max -max $min
  277.         } else {
  278.         $graph axis configure $axis -min $min -max $max
  279.         }
  280.     }
  281.     }
  282.     busy hold $graph 
  283.     update;                # This "update" redraws the graph
  284.     busy release $graph
  285. }
  286.  
  287. #
  288. # This routine terminates either an existing zoom, or pops back to
  289. # the previous zoom level (if no zoom is in progress).
  290. #
  291.  
  292. proc blt::ResetZoom { graph } {
  293.     global zoomInfo 
  294.  
  295.     if { ![info exists zoomInfo($graph,corner)] } {
  296.     blt::InitStack $graph 
  297.     }
  298.     eval $graph marker delete [$graph marker names "zoom*"]
  299.  
  300.     if { $zoomInfo($graph,corner) == "A" } {
  301.     # Reset the whole axis
  302.     blt::PopZoom $graph
  303.     } else {
  304.     global zoomMod
  305.  
  306.     if { [info exists zoomMod] } {
  307.         set modifier $zoomMod
  308.     } else {
  309.         set modifier "Any-"
  310.     }
  311.     set zoomInfo($graph,corner) A
  312.     blt::RemoveBindTag $graph select-region-$graph
  313.     }
  314. }
  315.  
  316. option add *zoomTitle.font      -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-* 
  317. option add *zoomTitle.shadow      yellow4
  318. option add *zoomTitle.foreground  yellow1
  319. option add *zoomTitle.coords      "-Inf Inf"
  320.  
  321. proc blt::ZoomTitleNext { graph } {
  322.     global zoomInfo
  323.     set level [expr [llength $zoomInfo($graph,stack)] + 1]
  324.     if { [$graph cget -invertxy] } {
  325.     set coords "-Inf -Inf"
  326.     } else {
  327.     set coords "-Inf Inf"
  328.     }
  329.     $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
  330.     -coords $coords -bindtags "" -anchor nw
  331. }
  332.  
  333. proc blt::ZoomTitleLast { graph } {
  334.     global zoomInfo
  335.  
  336.     set level [llength $zoomInfo($graph,stack)]
  337.     if { $level > 0 } {
  338.          $graph marker create text -name "zoomTitle" -anchor nw \
  339.         -text "Zoom #$level" 
  340.     }
  341. }
  342.  
  343.  
  344. proc blt::SetZoomPoint { graph x y } {
  345.     global zoomInfo zoomMod
  346.     if { ![info exists zoomInfo($graph,corner)] } {
  347.     blt::InitStack $graph
  348.     }
  349.     blt::GetCoords $graph $x $y $zoomInfo($graph,corner)
  350.     if { [info exists zoomMod] } {
  351.     set modifier $zoomMod
  352.     } else {
  353.     set modifier "Any-"
  354.     }
  355.     bind select-region-$graph <${modifier}Motion> { 
  356.     blt::GetCoords %W %x %y B
  357.     #blt::MarkPoint $graph B
  358.     blt::Box %W
  359.     }
  360.     if { $zoomInfo($graph,corner) == "A" } {
  361.     if { ![$graph inside $x $y] } {
  362.         return
  363.     }
  364.     # First corner selected, start watching motion events
  365.  
  366.     #blt::MarkPoint $graph A
  367.     blt::ZoomTitleNext $graph 
  368.  
  369.     blt::AddBindTag $graph select-region-$graph
  370.     set zoomInfo($graph,corner) B
  371.     } else {
  372.     # Delete the modal binding
  373.     blt::RemoveBindTag $graph select-region-$graph
  374.     blt::PushZoom $graph 
  375.     set zoomInfo($graph,corner) A
  376.     }
  377. }
  378.  
  379. option add *zoomOutline.dashes        4    
  380. option add *zoomTitle.anchor        nw
  381. option add *zoomOutline.lineWidth    2
  382. option add *zoomOutline.xor        yes
  383.  
  384. proc blt::MarchingAnts { graph offset } {
  385.     global zoomInfo
  386.  
  387.     incr offset
  388.     if { [$graph marker exists zoomOutline] } {
  389.     $graph marker configure zoomOutline -dashoffset $offset 
  390.     set interval $zoomInfo($graph,interval)
  391.     set id [after $interval [list blt::MarchingAnts $graph $offset]]
  392.     set zoomInfo($graph,afterId) $id
  393.     }
  394. }
  395.  
  396. proc blt::Box { graph } {
  397.     global zoomInfo
  398.  
  399.     if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } { 
  400.     set x1 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
  401.     set y1 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
  402.     set x2 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
  403.     set y2 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
  404.     } else {
  405.     set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
  406.     set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
  407.     set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
  408.     set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
  409.     }
  410.     set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
  411.     if { [$graph marker exists "zoomOutline"] } {
  412.     $graph marker configure "zoomOutline" -coords $coords 
  413.     } else {
  414.     set X [lindex [$graph xaxis use] 0]
  415.     set Y [lindex [$graph yaxis use] 0]
  416.     $graph marker create line -coords $coords -name "zoomOutline" \
  417.         -mapx $X -mapy $Y
  418.     set interval $zoomInfo($graph,interval)
  419.     set id [after $interval [list blt::MarchingAnts $graph 0]]
  420.     set zoomInfo($graph,afterId) $id
  421.     }
  422. }
  423.  
  424.  
  425. proc Blt_PostScriptDialog { graph } {
  426.     set top $graph.top
  427.     toplevel $top
  428.  
  429.     foreach var { center landscape maxpect preview decorations padx 
  430.     pady paperwidth paperheight width height colormode } {
  431.     global $graph.$var
  432.     set $graph.$var [$graph postscript cget -$var]
  433.     }
  434.     set row 1
  435.     set col 0
  436.     label $top.title -text "PostScript Options"
  437.     table $top $top.title -cspan 7
  438.     foreach bool { center landscape maxpect preview decorations } {
  439.     set w $top.$bool-label
  440.     label $w -text "-$bool" -font *courier*-r-*12* 
  441.     table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
  442.     set w $top.$bool-yes
  443.     global $graph.$bool
  444.     radiobutton $w -text "yes" -variable $graph.$bool -value 1
  445.     table $top $row,$col+1 $w -anchor w
  446.     set w $top.$bool-no
  447.     radiobutton $w -text "no" -variable $graph.$bool -value 0
  448.     table $top $row,$col+2 $w -anchor w
  449.     incr row
  450.     }
  451.     label $top.modes -text "-colormode" -font *courier*-r-*12* 
  452.     table $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }
  453.     set col 1
  454.     foreach m { color greyscale } {
  455.     set w $top.$m
  456.     radiobutton $w -text $m -variable $graph.colormode -value $m
  457.     table $top $row,$col $w -anchor w
  458.     incr col
  459.     }
  460.     set row 1
  461.     frame $top.sep -width 2 -bd 1 -relief sunken
  462.     table $top $row,3 $top.sep -fill y -rspan 6
  463.     set col 4
  464.     foreach value { padx pady paperwidth paperheight width height } {
  465.     set w $top.$value-label
  466.     label $w -text "-$value" -font *courier*-r-*12* 
  467.     table $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }
  468.     set w $top.$value-entry
  469.     global $graph.$value
  470.     entry $w -textvariable $graph.$value -width 8
  471.     table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
  472.     incr row
  473.     }
  474.     table configure $top c3 -width .125i
  475.     button $top.cancel -text "Cancel" -command "destroy $top"
  476.     table $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3
  477.     button $top.reset -text "Reset" -command "destroy $top"
  478.     #table $top $row,1 $top.reset  -width 1i
  479.     button $top.print -text "Print" -command "blt::ResetPostScript $graph"
  480.     table $top $row,4 $top.print  -width 1i -pady 2 -cspan 2
  481. }
  482.  
  483. proc blt::ResetPostScript { graph } {
  484.     foreach var { center landscape maxpect preview decorations padx 
  485.     pady paperwidth paperheight width height colormode } {
  486.     global $graph.$var
  487.     set old [$graph postscript cget -$var]
  488.     if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {
  489.         $graph postscript configure -$var $old
  490.         set $graph.$var $old
  491.     }
  492.     }
  493.     $graph postscript output "out.ps"
  494.     puts stdout "wrote file \"out.ps\"."
  495.     flush stdout
  496. }
  497.